home *** CD-ROM | disk | FTP | other *** search
/ Softdisk Supreme / Softdisk Supreme.iso / pc / DSK Files / 0-49 / SD011a.dsk / BASICALC IN APPLESOFT.bas < prev    next >
BASIC Source File  |  2003-06-12  |  12KB  |  394 lines
  1. 1  REM  CHANGES IN:
  2. 2  REM    2104, 2109, 2256   
  3. 3  REM  1110, 6240, 660,
  4. 4  REM  265, 240, 2905
  5. 5  REM  640, 641
  6. 6  REM  7/30/82
  7. 10  REM **************************
  8. 11  REM *                        *
  9. 12  REM * ELECTRONIC WORKSHEET   *
  10. 13  REM *                        *
  11. 14  REM * COPYRIGHT (C) 1982     *
  12. 15  REM *  WILLIAM V R SMITH     *
  13. 16  REM *                        *
  14. 17  REM **************************
  15. 18  REM 
  16. 19  CLEAR : DIM A$(70,10),B$(70,10),CW(12),IV(50)
  17. 20 SY = 1:XM = 1:YM = 1:SX = 1
  18. 30  FOR X = 1 TO 12:CW(X) = 9: NEXT X
  19. 35 S$ = "                   "
  20. 37 T$ = "ABCDEFGHIJKLMNO"
  21. 38 T1$ = "*********************"
  22. 99  GOTO 2000
  23. 100  REM  *******************
  24. 101  REM  * VARABLE PARCER  *
  25. 102  REM  *******************
  26. 103 L =  LEN(A$(Y,X)):F = 2:A1 = 0:A2 = 0:P = 1:H$ = "":OF = 1
  27. 105  IF L = 0  THEN 400
  28. 110  IF P >L  THEN 400
  29. 115  GOSUB 500
  30. 130  IF C >64  THEN  GOSUB 450: IF P >L  THEN  RETURN 
  31. 135  IF C = 46  THEN 170
  32. 140  IF C >41  AND C <48  THEN  GOSUB 200:F = C -41: GOTO 110
  33. 150  IF C = 38  THEN 700
  34. 160  IF C >47  AND C <58  THEN 170
  35. 162  IF C = 58  THEN 900
  36. 165  GOTO 400
  37. 170 H$ = H$ + CHR$(C): IF P >L  THEN  GOSUB 200: GOTO 600
  38. 180  GOSUB 500: GOTO 130
  39. 200 A2 =  VAL(H$):H$ = "": GOSUB 300: REM  FUNCTION
  40. 210  RETURN 
  41. 220  REM * INPUT STATEMENT **
  42. 225 IV = 1:I$ = "": GOTO 235
  43. 230  IF  LEN(I$) = 0  THEN A$ = "": RETURN 
  44. 235  GET A$
  45. 240  IF A$ =  CHR$(8)  THEN L =  LEN(I$):I$ =  MID$ (" " +I$,2,L -1): VTAB 2: HTAB 1: PRINT I$;: CALL  -868: GOTO 230
  46. 245  IF A$ =  CHR$(21)  THEN 275
  47. 250  IF A$ =  CHR$(13)  THEN 280
  48. 255  IF  ASC(A$) <31  THEN 235
  49. 256  IF A$ =  CHR$(34)  THEN 235
  50. 260 I$ = I$ +A$
  51. 265  VTAB 2: HTAB 1: PRINT I$;
  52. 270 IV = IV +1: GOTO 235
  53. 275 A$ =  MID$ (A$(Y,X),IV,1): GOTO 260
  54. 280  IF IV = 1  THEN A$ = "": RETURN 
  55. 285 A$ = I$: RETURN 
  56. 300  REM *********************
  57. 301  REM *
  58. 302  REM * PERFORM MATH FUNCTION  
  59. 303  REM *
  60. 304  REM *********************
  61. 305 F1 = F:F = 2
  62. 310  ON F1 GOSUB 330,340,320,350,320,370
  63. 320  RETURN 
  64. 330 A1 = A1 *A2: RETURN 
  65. 340 A1 = A1 +A2: RETURN 
  66. 350 A1 = A1 -A2: RETURN 
  67. 370  IF A2 < >0  THEN A1 = A1/A2
  68. 380  RETURN 
  69. 399  END 
  70. 400 H$ =  MID$ (A$(Y,X),1,L) +"                         "
  71. 405 H$ =  LEFT$(H$,CW(X))
  72. 406  IF H$ = B$(Y,X)  THEN  RETURN 
  73. 407 B$(Y,X) = H$
  74. 409  GOSUB 680: REM   * XM AND YM TEST
  75. 410  RETURN 
  76. 440  REM *****************
  77. 441  REM *
  78. 442  REM * FIND MATH VALUE
  79. 443  REM * OF SCREEN
  80. 444  REM *****************
  81. 450 X3 = C -64
  82. 451  IF X3 >15  THEN  GOSUB 400: RETURN 
  83. 452 H$ = "": IF L = 1  THEN 400
  84. 453  GOSUB 500: IF C <48  OR C >57  THEN  GOTO 400
  85. 454  GOTO 460
  86. 455  GOSUB 500
  87. 460  IF C <48  OR C >57  THEN 470
  88. 465 H$ = H$ + CHR$(C)
  89. 466  IF P >L  THEN 470
  90. 467  GOTO 455
  91. 470 Y3 =  VAL(H$)
  92. 475  IF Y3 >70  OR X3 >15  THEN H$ = "ERROR":P = L +1: GOTO 620
  93. 480 H$ = B$(Y3,X3)
  94. 485  GOSUB 200
  95. 490  IF P >L  THEN  GOSUB 600: RETURN 
  96. 495  RETURN 
  97. 500  REM *** PARCE LINE FOR CHAR
  98. 510 C =  ASC( MID$ (A$(Y,X),P,1)):P = P +1
  99. 520  RETURN 
  100. 600  REM *******************
  101. 601  REM *
  102. 602  REM * ASSIGN ANSWER
  103. 603  REM *
  104. 604  REM *******************
  105. 610  IF A$(Y,X) = ""  THEN  RETURN 
  106. 615  IF  LEN( STR$( INT(A1))) >CW(X)  THEN H$ = "ERROR"
  107. 620  ON OF GOSUB 640,650,660,670
  108. 625  IF OF = 4  OR OF = 1  THEN 675
  109. 630 B$(Y,X) =  RIGHT$("                                " + STR$(A1),CW(X))
  110. 635  GOTO 675
  111. 640 SF$ = "": IF A1 <0  THEN SF$ = "-"
  112. 641 WA =  ABS(A1):A3 =  INT(WA):A1 = (WA -A3) +1.001:H$ = SF$ + STR$(A3) +"." + MID$ ( STR$(A1),3,2)
  113. 645 B$(Y,X) =  RIGHT$(S$ +H$,CW(X)): RETURN 
  114. 650 A1 =  INT(A1): RETURN 
  115. 660 FL$ =  STR$(A1):A1 =  VAL( LEFT$(FL$,CW(X))): RETURN 
  116. 670 A1 =  INT(A1): IF A1 >20  THEN A1 = 20
  117. 671  IF A1 <1  THEN A1 = 1
  118. 672 B$(Y,X) =  LEFT$( LEFT$(T1$,A1) +"                   ",CW(X))
  119. 673  RETURN 
  120. 675 OF = 1
  121. 680  IF X >XM  THEN XM = X
  122. 681  IF Y >YM  THEN YM = Y
  123. 690  RETURN 
  124. 700  REM **** SUM(FUNCTION)
  125. 710 P = P +4: GOSUB 500
  126. 720  GOSUB 450:Y4 = Y3:X4 = X3
  127. 730  GOSUB 500: GOSUB 450
  128. 740 A1 = 0:A2 = 0:X5 = X3:Y5 = Y3
  129. 750  IF Y4 = Y5  THEN 800
  130. 760 X3 = X4: FOR Y3 = Y4 TO Y5
  131. 765 P = 1
  132. 770  GOSUB 480
  133. 780  NEXT Y3
  134. 790  GOSUB 600: RETURN 
  135. 800 Y3 = Y4: FOR X3 = X4 TO X5
  136. 805 P = 1
  137. 810  GOSUB 480
  138. 820  NEXT X3
  139. 830  GOSUB 600: RETURN 
  140. 900  REM * OUTPUT FORMAT *
  141. 905  GOSUB 200: GOSUB 500
  142. 910  IF C = 36  THEN OF = 1: GOTO 600
  143. 920  IF C = 73  THEN OF = 2: GOTO 600
  144. 930  IF C = 70  THEN OF = 3: GOTO 600
  145. 940  IF C = 42  THEN OF = 4: GOTO 600
  146. 950  GOTO 600
  147. 1000  REM ********************
  148. 1001  REM * VIDEO SCREEN LAYOUT
  149. 1002  REM ********************
  150. 1099  NORMAL 
  151. 1100  FOR Y1 = 1 TO 70
  152. 1103  VTAB 1: HTAB 25: FLASH : PRINT "WORKING";
  153. 1105  IF Y1 >YM  THEN Y1 = 100: GOTO 1180
  154. 1110  FOR X1 = 1 TO 10
  155. 1111  IF A$(Y1,X1) = ""  THEN  NEXT X1: GOTO 1180
  156. 1112  VTAB 1: HTAB 34: PRINT  MID$ (T$,X1,1);Y1;" "
  157. 1115  IF X1 >XM  THEN X1 = 100: GOTO 1170
  158. 1121 X2 = X:Y2 = Y
  159. 1122 X = X1:Y = Y1
  160. 1125  GOSUB 100
  161. 1140 X = X2:Y = Y2
  162. 1170  NEXT X1
  163. 1180  NEXT Y1
  164. 1185  GOSUB 1500
  165. 1186  VTAB 1: HTAB 25: CALL  -868
  166. 1190  RETURN 
  167. 1300  REM ********************
  168. 1301  REM * SCREEN VALUE PRINTER
  169. 1302  REM ********************
  170. 1305 CW(0) = 0
  171. 1306  IF CW(X) < > LEN(B$(Y,X))  THEN  GOSUB 100
  172. 1307  IF X = SX  THEN CO = 3: GOTO 1330
  173. 1310 CO = 0: FOR X2 = SX TO X -1:CO = CO +CW(X2): NEXT X2:CO = CO +3
  174. 1330  VTAB Y +5 -SY: HTAB CO
  175. 1340  PRINT B$(Y,X);
  176. 1399  RETURN 
  177. 1500  REM *****************************
  178. 1501  REM *
  179. 1502  REM * SCREEN PRINT
  180. 1503  REM *
  181. 1504  REM *****************************
  182. 1550  VTAB 4: HTAB 1
  183. 1600  INVERSE 
  184. 1602  PRINT "  ";:MT = 10
  185. 1603 PP = 0: FOR FX = SX TO 10:PP = PP +CW(FX): IF PP >37  THEN MT = FX -1:FX = 11
  186. 1604  NEXT FX
  187. 1605  FOR FX = SX TO MT
  188. 1606 H = CW(FX)/2:H1 =  INT(H):H2 =  INT(H -.2)
  189. 1609 H$ =  LEFT$(S$,H1) + MID$ (T$,FX,1) + LEFT$(S$,H2)
  190. 1610  PRINT H$;
  191. 1612  NEXT FX
  192. 1613  CALL  -868
  193. 1614  VTAB 5: HTAB 1
  194. 1615  FOR FX = SY TO 18 +SY: PRINT FX;: IF FX <10  THEN  PRINT " ";
  195. 1616  PRINT : NEXT FX
  196. 1617  VTAB 5
  197. 1618  NORMAL : POKE 32,2: POKE 33,38: VTAB 5: CALL  -958: POKE 32,0: POKE 33,40
  198. 1619 A = SX:T = 3
  199. 1620  VTAB 5
  200. 1621  FOR X1 = 0 TO 18
  201. 1625  HTAB T: PRINT B$(SY +X1,A)
  202. 1800  NEXT X1
  203. 1850 T = T +CW(A):A = A +1: IF A =  <MT  THEN 1620
  204. 1999  RETURN 
  205. 2000  REM **************
  206. 2001  REM *
  207. 2002  REM * PROMPT OF INPUT
  208. 2003  REM *
  209. 2004  REM **************
  210. 2005 DF = 1
  211. 2006  HOME 
  212. 2010  GOSUB 1500
  213. 2020 X = 1:Y = 1
  214. 2030  VTAB 1: HTAB 1: PRINT  MID$ (T$,X,1);Y;"   "
  215. 2035  VTAB 2: HTAB 1: PRINT A$(Y,X);
  216. 2050  INVERSE 
  217. 2060  GOSUB 1300
  218. 2070  NORMAL 
  219. 2080  GOTO 2220
  220. 2090  REM ***************
  221. 2091  REM *
  222. 2092  REM * INPUT AND PERFORM
  223. 2093  REM *
  224. 2094  REM ***************
  225. 2100 A =  PEEK( -16384): IF A <127  THEN 2100
  226. 2102 A = A -128:A$ =  CHR$(A)
  227. 2103  IF A = 47  THEN 4000
  228. 2104  IF A = 64  THEN 2256
  229. 2105  IF A = 33  THEN  GOSUB 1300: GOSUB 1000: GOTO 2050
  230. 2106  IF A = 21  THEN 2113
  231. 2107  IF A = 8  THEN 2160
  232. 2108  IF A = 32  THEN 2200
  233. 2109  IF A >43  THEN 2255
  234. 2110  IF A = 38  THEN 2300
  235. 2111  IF A = 34  THEN  GET A$: GOTO 2255
  236. 2112  GET A$: GOTO 2090
  237. 2113  GOSUB 1300
  238. 2114  ON DF +2 GOTO 2115,2140,2130
  239. 2115 X = X +1: IF X >10  THEN X = 10: INVERSE : GOSUB 1300: NORMAL : GOTO 2900
  240. 2116  IF X >MT  THEN SX = SX +1: GOSUB 1500: GOTO 2116
  241. 2120  INVERSE : GOSUB 1300: NORMAL : GOTO 2900
  242. 2130 Y = Y +1: IF Y >69  THEN Y = 69: GOTO 2135
  243. 2133  IF Y >18 +SY  THEN X3 =  -1:SY = SY +10:Y = SY +18: IF Y >69  THEN Y = 69:SY = 69 -18
  244. 2134  IF X3 =  -1  THEN  GOSUB 1500:X3 = 0
  245. 2135  INVERSE : GOSUB 1300: NORMAL 
  246. 2140  GOTO 2900
  247. 2150  REM 
  248. 2160  ON DF +2 GOTO 2170,2190,2180
  249. 2170  GOSUB 1300
  250. 2175 X = X -1: IF X > = SX  THEN  INVERSE : GOSUB 1300: NORMAL : GOTO 2900
  251. 2176 SX = SX -1: IF X = 0  THEN X = 1:SX = 1: GOTO 2179
  252. 2177  GOSUB 1500
  253. 2179  INVERSE : GOSUB 1300: NORMAL : GOTO 2900
  254. 2180  GOSUB 1300
  255. 2182 Y = Y -1: IF Y =  >SY  THEN  INVERSE : GOSUB 1300: NORMAL : GOTO 2900
  256. 2183 SY = SY -10:Y = SY: IF Y < = 0  THEN Y = 1:SY = 1
  257. 2184  GOSUB 1500
  258. 2185  INVERSE : GOSUB 1300: NORMAL : GOTO 2900
  259. 2190  REM 
  260. 2200  REM ********************
  261. 2201  REM *
  262. 2202  REM * SHOW CURSOR DIRECTION
  263. 2203  REM *
  264. 2204  REM ********************
  265. 2205  REM 
  266. 2210 DF = DF * -1
  267. 2220  VTAB 1: HTAB 38
  268. 2230  ON DF +2 GOTO 2231,2240,2235
  269. 2231  PRINT "-";: GOTO 2240
  270. 2235  PRINT "!";: GOTO 2240
  271. 2240  GOTO 2900
  272. 2250  REM ** INPUT STRING FOR PAGE
  273. 2251  REM 
  274. 2252  GOTO 4000
  275. 2254  IF A$ = "&"  THEN 2300
  276. 2255  VTAB 2: HTAB 1: PRINT A$(Y,X);: VTAB 2: HTAB 1: GOSUB 220
  277. 2256 AA$ = "                                       ": IF A$ = "@"  THEN A$(Y,X) =  LEFT$(AA$,CW(X)): GOTO 2260
  278. 2257  IF A$ = ""  THEN 2270
  279. 2258 A$(Y,X) = A$
  280. 2260  GOSUB 100
  281. 2270  GOTO 2030
  282. 2300  REM ** SUM STATEMENT **
  283. 2310  POKE  -16368,0
  284. 2320  VTAB 1: HTAB 1: CALL  -868
  285. 2330  VTAB 2: INPUT "SUM(START = ";A$
  286. 2350  VTAB 2: CALL  -868: PRINT "SUM(";A$;" THRU ";: INPUT "";B$
  287. 2360  VTAB 2: HTAB 1: PRINT "SUM(";A$;" THRU "B$;")"
  288. 2365  IF A$ = ""  OR B$ = ""  THEN 2900
  289. 2370 A$(Y,X) = "&SUM(" +A$ +"-" +B$ +")"
  290. 2380  GOSUB 100: GOTO 2030
  291. 2900  VTAB 1: HTAB 1: PRINT  MID$ (T$,X,1);Y;"   "
  292. 2904  VTAB 2: HTAB 1: PRINT A$(Y,X);
  293. 2905  CALL  -868
  294. 2906  IF  PEEK(37) = 1  THEN  VTAB 3: HTAB 1: CALL  -868
  295. 2907  POKE  -16368,0
  296. 2910  GOTO 2100
  297. 4000  REM *****************
  298. 4001  REM *
  299. 4002  REM * HANDLE GLOBAL COMMAND
  300. 4003  REM *
  301. 4004  REM ******************
  302. 4005  POKE  -16368,0
  303. 4006  VTAB 2: HTAB 1: CALL  -868
  304. 4010  INPUT "1-WIDTH  2-SAVE  3-LOAD  4-CLEAR        5-GOTO LOCATION  6 - PRINT";A$
  305. 4015  ON  VAL(A$) GOTO 4020,5000,5500,19,6000,7000
  306. 4016  GOTO 6000
  307. 4020  VTAB 2: CALL  -868: INPUT "WIDTH = ";A$:A =  VAL(A$): IF A >30  THEN 4020
  308. 4030 CW(X) = A
  309. 4040 YH = Y
  310. 4050  FOR Y = 1 TO YM: GOSUB 400: NEXT Y
  311. 4060 Y = YH
  312. 4140  GOSUB 1100
  313. 4150  GOSUB 5900: GOTO 2030
  314. 5000  REM ***********
  315. 5001  REM *
  316. 5002  REM * DISK I/O
  317. 5003  REM *
  318. 5004  REM ***********
  319. 5100  REM * FILE OUT *
  320. 5105  GOSUB 5900
  321. 5110  VTAB 2: HTAB 1: CALL  -868
  322. 5120  PRINT "SAVE FILE TO DISK  FILENAME = "
  323. 5130  INPUT "";A$
  324. 5140  IF A$ = ""  THEN  GOSUB 5900: GOTO 2030
  325. 5146  VTAB 1: HTAB 1: PRINT 
  326. 5150  PRINT  CHR$(4);"OPEN  ";A$
  327. 5160  PRINT  CHR$(4);"WRITE ";A$
  328. 5165  PRINT XM: PRINT YM
  329. 5170  FOR X = 1 TO XM
  330. 5180  PRINT CW(X)
  331. 5190  FOR Y = 1 TO YM
  332. 5200  PRINT  CHR$(34);A$(Y,X); CHR$(34)
  333. 5210  NEXT Y
  334. 5220  PRINT "<>"
  335. 5230  NEXT X
  336. 5240  PRINT "<>"
  337. 5250  PRINT  CHR$(4);"CLOSE"
  338. 5255 Y = 1:X = 1
  339. 5260  GOTO 7230
  340. 5500  REM * FILE IN *
  341. 5510  HOME : PRINT  CHR$(4);"CATALOG"
  342. 5549  VTAB 1: HTAB 1
  343. 5550  PRINT "READ FILE FROM DISK  FILENAME = "
  344. 5560  GOSUB 220: PRINT "": IF A$ = ""  THEN  GOSUB 5900: GOTO 2030
  345. 5565  PRINT  CHR$(4);"UNLOCK";A$
  346. 5570  PRINT  CHR$(4);"OPEN ";A$
  347. 5580  PRINT  CHR$(4);"READ ";A$
  348. 5590  INPUT XM: INPUT YM
  349. 5600  FOR X = 1 TO XM
  350. 5610  INPUT CW(X)
  351. 5620  FOR Y = 1 TO YM
  352. 5630  INPUT A$(Y,X)
  353. 5640  NEXT Y
  354. 5650  INPUT B$: REM  ERROR IF NOT <>
  355. 5660  NEXT X
  356. 5670  INPUT B$: REM  ERROR IF NOT <> 
  357. 5675  PRINT  CHR$(4);"CLOSE"
  358. 5677  GOSUB 5900
  359. 5678 X = 1:Y = 1
  360. 5680  GOSUB 1000: GOTO 2020
  361. 5900  VTAB 1: HTAB 1: CALL  -868
  362. 5910  VTAB 2: HTAB 1: CALL  -868
  363. 5920  VTAB 3: HTAB 1: CALL  -868
  364. 5930  RETURN 
  365. 6000  REM ** GOTO LOCATION
  366. 6005  GOSUB 6010: GOTO 2030
  367. 6010  GOSUB 5900
  368. 6030  VTAB 2: HTAB 1: INPUT "GO TO PAGE LOCATION :";A$
  369. 6040  GOSUB 6200
  370. 6050  IF X1 +Y1 = 0  THEN  RETURN 
  371. 6180 X = X1:SX = X1:Y = Y1:SY = Y1
  372. 6185  GOSUB 1500
  373. 6190  INVERSE : GOSUB 1300: NORMAL : RETURN 
  374. 6200 L =  LEN(A$): IF L <2  THEN X1 = 0:Y1 = 0: RETURN 
  375. 6210 X1 =  ASC( LEFT$(A$,1)) -64
  376. 6220  IF X1 <1  OR X1 >10  THEN X1 = 0: RETURN 
  377. 6230 Y1 =  VAL( RIGHT$(A$,L -1))
  378. 6240  IF Y1 <1  OR Y1 >51  THEN X1 = 0:Y1 = 0
  379. 6250  RETURN 
  380. 7000  REM *** PRINT OUT
  381. 7100  GOSUB 5900
  382. 7110  VTAB 2: HTAB 1: INPUT "UPPER/LEFT CORNER:";A$: GOSUB 6200
  383. 7120 X3 = X1:Y3 = Y1
  384. 7130  VTAB 2: HTAB 1: INPUT "LOWER/RIGHT CORNER :";A$: GOSUB 6200
  385. 7140 X4 = X1:Y4 = Y1
  386. 7150  PRINT  CHR$(4);"PR#1"
  387. 7160  FOR Y1 = Y3 TO Y4
  388. 7170  FOR X1 = X3 TO X4
  389. 7180  PRINT  LEFT$(B$(Y1,X1) +S$,CW(X1));
  390. 7190  NEXT X1
  391. 7200  PRINT 
  392. 7210  NEXT Y1
  393. 7220  PRINT  CHR$(4);"PR#0"
  394. 7230 X1 = 1:Y1 = 1: GOSUB 6180: GOTO 2030